home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / graphic / 1svga.zip / VGATSR.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-29  |  3KB  |  130 lines
  1. { VGATSR ─── Get Palette,Screen & Show Palette,Screen }
  2. {$M 8192,0,0} {$F+}
  3.  
  4. uses Dos,SVGA256,Txt;
  5.  
  6. var OldInt9:procedure;
  7.     OldSS,OldSP,MySS,MySP,Act:integer;
  8.     Buf:array[0..4095] of byte;
  9.  
  10. { ─────────────── Get_Palette ─────────────── }
  11. procedure Get_Palette;
  12. var St:string;
  13. begin
  14.   Get(0,0,320,9,Buf);
  15.   Bar(0,0,320,9,1);
  16.   Print(0,0,14,'Pal-'); Input(32,0,14,1,32,St);
  17.   Put(0,0,320,9,Buf);
  18.   GetPalette(0,256,Buf);
  19.   FileWrite(St,0,768,1,Buf);
  20. end;
  21. { ─────────────── GetScreen ─────────────── }
  22. procedure GetScreen;
  23. var I:integer;
  24.     File1:file;
  25.     St:string;
  26. begin
  27.   Get(0,0,320,9,Buf);
  28.   Bar(0,0,320,9,1);
  29.   Print(0,0,14,'Scr-'); Input(32,0,14,1,32,St);
  30.   Put(0,0,320,9,Buf);
  31.   GetPalette(0,256,Buf);
  32.   Assign(File1,St); Rewrite(File1,1);
  33.   BlockWrite(File1,Buf,768);
  34.   for I:=0 to 24 do begin
  35.     Get(0,I shl 3,320,8,Buf);
  36.     BlockWrite(File1,Buf,2560);
  37.   end;
  38.   Close(File1);
  39. end;
  40. { ─────────────── ShowPalette ─────────────── }
  41. procedure ShowPalette(X,Y:integer);    { 64x64 }
  42. var I:integer;
  43. begin
  44.   Get(X,Y,64,64,Buf);
  45.   for I:=0 to 255 do Bar(4*(I and 15)+X,4*(I shr 4)+Y,4,4,I);
  46.   I:=Key;
  47.   Put(X,Y,64,64,Buf);
  48. end;
  49. { ─────────────── VGATSR ─────────────── }
  50. procedure VGATSR;
  51. begin
  52.   if Mem[0:$449]<>$13 then Exit;
  53.   InstallFont(1,8,8,0,256,8,Mem[$F000:$FA6E]);
  54.   case Act of
  55.     1:Get_Palette;
  56.     2:GetScreen;
  57.     3:ShowPalette(128,68);
  58.   end;
  59. end;
  60. { ─────────────── MyInt9 ─────────────── }
  61. procedure MyInt9; interrupt;
  62. const Flag:byte=0;
  63. var M:byte;
  64. begin
  65.   asm pushf end; OldInt9;
  66.   if Flag=0 then begin
  67.     M:=Mem[0:$417]; Act:=0;
  68.     if M and 10=10 then Act:=1
  69.       else if M and 9=9 then Act:=2
  70.       else if M and 6=6 then Act:=3;
  71.     if Act>0 then begin
  72.       Flag:=1;
  73.       OldSS:=SSeg; OldSP:=SPtr;
  74.       asm cli; mov ss,MySS;  mov sp,MySP; sti end;
  75.       VGATSR;
  76.       asm cli; mov ss,OldSS; mov sp,OldSP; sti end;
  77.       Flag:=0;
  78.     end;
  79.   end;
  80. end;
  81. { ─────────────── InstallTSR ─────────────── }
  82. procedure InstallTSR;
  83. begin
  84.   if MemW[0:$180]=1001 then begin
  85.     Writeln('VGATSR has installed');
  86.     Writeln('Do not run it again !');
  87.     Halt(1);
  88.   end;
  89.   Writeln;
  90.   Writeln('VGATSR /320x200 256 Colors');
  91.   Writeln('Copyright (C) 1994 by Jou-Nan Chen');
  92.   Writeln;
  93.   Writeln('Alt+L_Shift............Get Palette');
  94.   Writeln('Alt+R_Shift.............Get Screen');
  95.   Writeln('Ctrl+L_Shift..........Show Palette');
  96.   Writeln('VGATSR Filename........Show Screen');
  97.   MemW[0:$180]:=12346;
  98.   GetIntVec(9,@OldInt9); SetIntVec(9,@MyInt9);
  99.   MySS:=SSeg; MySP:=SPtr;
  100.   Keep(ExitCode);
  101. end;
  102. { ─────────────── ShowScreen ─────────────── }
  103. procedure ShowScreen(Name:string);
  104. var I:integer;
  105.     File1:file;
  106. begin
  107.   Assign(File1,Name); Reset(File1,1);
  108.   BlockRead(File1,Buf,768);
  109.   SetMode(1);
  110.   SetPalette(0,256,Buf);
  111.   for I:=0 to 24 do begin
  112.     BlockRead(File1,Buf,2560);
  113.     Put(0,I shl 3,320,8,Buf);
  114.   end;
  115.   Close(File1);
  116.   I:=Key;
  117.   SetMode(0);
  118. end;
  119.  
  120. begin
  121.   Width:=320;
  122.   if ParamCount=0 then InstallTSR else begin
  123.     if FileLen(ParamStr(1),1)<>64768 then begin
  124.       Writeln('Picture file not found !');
  125.       Halt(1);
  126.     end;
  127.     ShowScreen(ParamStr(1));
  128.   end;
  129. end.
  130.